home *** CD-ROM | disk | FTP | other *** search
/ AOL File Library: 11,000 to 11,999 / 11000.zip / AOLDLs / Programmieren [Pascal - Sonstige] / COM-Routinen fuer Pascal / COMUNIT.pas next >
Pascal/Delphi Source File  |  2014-12-20  |  17KB  |  627 lines
  1. unit COMUnit;
  2.  
  3. { First release: 28 Feb 96 }
  4. { Last changes:  24 May 96 }
  5.  
  6. { v007 }
  7.  
  8. { COMUnit - Copyright (c) by Christian Muehlhaeuser and Michael Maluck }
  9. { All rights reserved }
  10. { Bei Benuetzung bitte eine Netmail an die 2:2480/313 }
  11. { Keine Haftung fuer jegliche Schaeden, die dieser Source-Code verursacht }
  12.  
  13. interface
  14.  
  15. uses
  16.   Dos,Crt;
  17.  
  18. const
  19.   BufSize=4096;
  20.   COMSoftFlow=1;
  21.   COMHardFlow=2;
  22.   COMUseFIFO=4;
  23.   COMUseFossil=8;
  24.   COMDetect=$80;
  25.  
  26. type
  27.   TCharBuf=array[0..BufSize] of Char;
  28.  
  29.   TFossilInfo=record
  30.     Size: Word;
  31.     Ver: Byte;
  32.     RevLev: Byte;
  33.     PtrSeg: Word;
  34.     PtrOfs: Word;
  35.     InputBufSize: Word;
  36.     InputBytes: Word;
  37.     OutputBufSize: Word;
  38.     OutputBytes: Word;
  39.     ScrWidth: Byte;
  40.     ScrHeight: Byte;
  41.     Baud: Byte;
  42.   end;
  43.  
  44.   PCOM=^TCOM;
  45.   TCOM=object
  46.     IOBase: Integer;
  47.     IRQ: Byte;
  48.     DataBits,Parity,StopBits: Byte;
  49.     SaveIOInt: Pointer;
  50.     SaveIER, SaveIMR: Byte;
  51.     Buffer: ^TCharBuf;
  52.     BufHead,BufTail,CharsInBuf: Word;
  53.     BufOverflow,SoftFlow: Boolean;
  54.     COMAttr,IOPort: Byte;
  55.     FossilName: String;
  56.     FossilVer: Byte;
  57.     constructor Init(AIOPort: Byte; ABaud: LongInt; ADataBits, AParity,
  58.                   AStopBits, ACOMAttr: Byte);
  59.     destructor Done;
  60.     procedure COMIRQ;
  61.     procedure EnableInts;
  62.     procedure DisableInts;
  63.     function CarrierDetect: Boolean;
  64.     procedure SendChar(C: Char);
  65.     procedure SendByte(B: Byte);
  66.     procedure SendStr(S: String);
  67.     function ByteAvail: Boolean;
  68.     function ReadChar: Char;
  69.     function ReadByte: Byte;
  70.     function ReadString: String;
  71.     function PeekChar: Char;
  72.     procedure FlushInput;
  73.     procedure SetDTR(DTROn: Boolean);
  74.     procedure SendBreak;
  75.     function HangUp: Boolean;
  76.     procedure GetCOMAttr(var ACOMAttr: Byte);
  77.   end;
  78.  
  79. var
  80.   COMAcc: array[1..4] of PCOM;
  81.  
  82. implementation
  83.  
  84. const
  85.   CSerIOBase: array[1..4] of Word=($3F8,$2F8,$3E8,$2E8);
  86.      CSerIRQ: array[1..4] of Byte=(4,3,4,3);
  87.  
  88.   { Relative Indizes zum seriellen IO-Port }
  89.   THR=0;      { transmitter holding register }
  90.   DLL=0;      { divisor latch low byte }
  91.   RBR=0;      { receiver buffer register }
  92.   DLH=1;      { divisor latch high byte }
  93.   IER=1;      { interrupt enable register }
  94.   FCR=2;      { fifo control register }
  95.   IIR=2;      { interrupt identification register }
  96.   LCR=3;      { line control register }
  97.   MCR=4;      { modem control register }
  98.   LSR=5;      { line status register }
  99.   MSR=6;      { modem status register }
  100.  
  101.   { Für Bitzugriffe auf die Register }
  102.   CTS=$10;    { clear to send }
  103.   THRE=$20;   { transmitter holding register empty }
  104.   BRKSGN=$40; { break signal }
  105.   DLAB=$80;   { divisor latch access bit }
  106.   DR=1;       { data ready }
  107.   FQE=$40;    { fifo queues enabled }
  108.  
  109.   { Sonstige Konstanten }
  110.   PIC=$20; { programmable interrupt controller }
  111.   IMR=$21; { master interrupt mask register }
  112.  
  113.     CR=#13;
  114.   CRLF=#13#10;
  115.  
  116. var
  117.   Regs: Registers;
  118.  
  119. { COM-Port Initialisierung
  120.   ************************
  121.   Uebergabe:
  122.      APort = COM-Port der anzusprechen ist (Bsp: COM2 = 2)
  123.      ABaud = Baud-Rate mit der er initialisiert werden soll (Bsp: 19200)
  124.      ADataBits = 5-8 DataBits (0h,1h,2h,3h)
  125.      AParity = None,Odd,Even (0h,8h,18h)         Standard: 3h,0h,0h = 8N1
  126.      AStopBits = 2,1 (4h,0h)
  127.      Attr = COMSoftFlow,COMHardFlow,COMUseFIFO,COMUseFossil,COMDetect
  128.             und alle Kombinationen
  129.   Rueckgabe: Nichts }
  130.  
  131. constructor TCOM.Init;
  132.      var
  133.       I,Dummy: Byte;
  134.       FossilRec: TFossilInfo;
  135.      begin
  136.        IOPort:=AIOPort;
  137.        BufHead:=0;
  138.        BufTail:=0;
  139.        CharsInBuf:=0;
  140.        BufOverflow:=False;
  141.        COMAttr:=ACOMAttr;
  142.        New(Buffer);
  143.  
  144.        if COMAttr and COMDetect>0 then begin
  145.          COMAttr:=COMAttr and (not COMDetect);
  146.          GetCOMAttr(COMAttr);
  147.        end;
  148.  
  149.        if COMAttr and COMUseFossil>0 then begin
  150.          Regs.AH:=4;
  151.          Regs.DX:=IOPort-1;
  152.          Intr($14,Regs);
  153.          if Regs.AX<>$1954 then
  154.            COMAttr:=COMAttr and (not COMUseFossil)
  155.          else begin
  156.            case Word(ABaud) of
  157.              300: Regs.AL:=$40;
  158.              600: Regs.AL:=$60;
  159.              1200: Regs.AL:=$80;
  160.              2400: Regs.AL:=$A0;
  161.              4800: Regs.AL:=$C0;
  162.              9600: Regs.AL:=$E0;
  163.              19200: Regs.AL:=0;
  164.              else Regs.AL:=$20;
  165.            end;
  166.            Regs.AL:=Regs.AL or ADataBits or AParity or AStopBits;
  167.            Intr($14,Regs);
  168.            Regs.AH:=3;
  169.            Regs.DX:=IOPort-1;
  170.            Intr($14,Regs);
  171.            Regs.AH:=$1B;
  172.            Regs.CX:=SizeOf(FossilRec);
  173.            Regs.ES:=Seg(FossilRec);
  174.            Regs.DI:=Ofs(FossilRec);
  175.            Regs.DX:=IOPort-1;
  176.            Intr($14,Regs);
  177.            I:=0;
  178.            repeat
  179.              FossilName[I+1]:=Chr(Mem[FossilRec.PtrOfs:FossilRec.PtrSeg+I]);
  180.              Inc(I);
  181.            until Mem[FossilRec.PtrOfs:FossilRec.PtrSeg+I]=0;
  182.            FossilName[0]:=Chr(I);
  183.            FossilVer:=FossilRec.Ver;
  184.          end;
  185.        end;
  186.        if COMAttr and COMUseFossil=0 then begin
  187.          IRQ:=CSerIRQ[IOPort];
  188.          IOBase:=CSerIOBase[IOPort];
  189.          DataBits:=ADataBits;
  190.          Parity:=AParity;
  191.          StopBits:=AStopBits;
  192.          COMAttr:=ACOMAttr;
  193.  
  194.          if COMAttr and COMUseFIFO>0 then begin
  195.            Port[IOBase+FCR]:=$C7; { activate and clear send&receive buffer,
  196.                                     14 byte trigger level }
  197.            if Port[IOBase+IIR] and FQE=0 then begin
  198.              Port[IOBase+FCR]:=0;
  199.              COMAttr:=COMAttr and (not COMUseFIFO);
  200.            end;
  201.          end;
  202.  
  203.          GetIntVec(IRQ+8,SaveIOInt);
  204.          SaveIER:=Port[IOBase+IER];
  205.          Port[IOBase+LCR]:=Port[IOBase+LCR] or DLAB;
  206.          Port[IOBase+DLL]:=Lo(115200 div ABaud);
  207.          Port[IOBase+DLH]:=Hi(115200 div ABaud);
  208.          Port[IOBase+LCR]:=ADataBits or AParity or AStopBits;
  209.          Port[IOBase+IER]:=$09;  { enable receive data+modem status ints }
  210.          Port[IOBase+MCR]:=$0B;  { turn on OUT2, RTS, DTR }
  211.          SetIntVec(IRQ+8,ptr(seg(TCOM.COMIRQ),
  212.            Ofs(TCOM.COMIRQ)+(AIOPort-1)*5+11));
  213.          case IOPort of
  214.            1: Port[IMR]:=Port[IMR] and $EF;
  215.            2: Port[IMR]:=Port[IMR] and $F7;
  216.            3: Port[IMR]:=Port[IMR] and $EF;
  217.            4: Port[IMR]:=Port[IMR] and $F7;
  218.          end;
  219.          for I:=0 to 5 do Dummy:=Port[IOBase+I];
  220.          Port[PIC]:=$20;
  221.        end;
  222.      end;
  223.  
  224. { Ruecksetzen aller veraenderten Register und Interruptvektoren
  225.   *************************************************************
  226.     Uebergabe: Nichts
  227.     Ausgabe: Nichts }
  228.  
  229. destructor TCOM.Done;
  230.      begin
  231.        if COMAttr and COMUseFossil>0 then begin
  232.          SetDTR(False);
  233.          Regs.AH:=5;
  234.          Regs.DX:=IOPort-1;
  235.          Intr($14,Regs);
  236.        end else begin
  237.          Port[IOBase+IER]:=SaveIER;
  238.          Port[IOBase+MCR]:=0;
  239.          Port[IOBase+IMR]:=SaveIMR;
  240.          SetIntVec(IRQ+8,SaveIOInt);
  241.          Port[PIC]:=$20;
  242.        end;
  243.        DisPose(Buffer);
  244.      end;
  245.  
  246. { Neue Interrupt Service-Routine
  247.   ******************************
  248.     KEIN DIREKTER AUFRUF !!
  249. }
  250.  
  251. procedure TCOM.COMIRQ; assembler;
  252.      const
  253.        Xon=#17;
  254.        Xoff=#19;
  255.        CIOBase=0;            { Offsets der Variablen relativ zum Objekt }
  256.        CBuffer=12;
  257.        CBufHead=16;
  258.        CCharsInBuf=20;
  259.        CBufOverflow=22;
  260.        CSoftFlow=23;
  261.        CCOMAttr=24;
  262.      asm
  263. @IOPort:
  264.        db 0
  265.        cli                   { Einsprung fuer COM1 }
  266.        mov  byte ptr cs:[@IOPort],0
  267.        jmp  @Start
  268.  
  269.        cli                   { Einsprung fuer COM2 }
  270.        mov  byte ptr cs:[@IOPort],1
  271.        jmp  @Start
  272.  
  273.        cli                   { Einsprung fuer COM3 }
  274.        mov  byte ptr cs:[@IOPort],2
  275.        jmp  @Start
  276.  
  277.        cli                   { Einsprung fuer COM4 }
  278.        mov  byte ptr cs:[@IOPort],3
  279.        jmp  @Start
  280.  
  281. @Start:push ax
  282.        push bx
  283.        push cx
  284.        push dx
  285.        push si
  286.        push di
  287.        push ds
  288.        push es
  289.        mov  bh,0
  290.        mov  bl,byte ptr cs:[@IOPort]
  291.        mov  dx,seg COMAcc
  292.        mov  ds,dx
  293.        mov  cl,2
  294.        shl  bx,cl
  295.        les  si,dword ptr COMAcc[bx]
  296. @NextChar:
  297.        cmp  word ptr es:[si+CCharsInBuf],BufSize
  298.        jnb  @BufFull
  299.        mov  dx,es:[si+CIOBase]
  300.        mov  bl,es:[si+CCOMAttr]
  301.        test bl,COMUseFIFO
  302.        jz   @NoFIFO1
  303.        push dx
  304.        add  dx,IIR
  305.        in   al,dx
  306.        pop  dx
  307.        test al,4        { received data in fifo queue }
  308.        jz   @NoData
  309. @NoFIFO1:
  310.        in   al,dx
  311.        test bl,COMSoftFlow
  312.        jz   @NoSoftFlow
  313.        cmp  al,XOn
  314.        jnz  @NoXOn
  315.        mov  byte ptr es:[si+CSoftFlow],True
  316.        jmp  @Ok
  317. @NoXOn:cmp  al,XOff
  318.        jnz  @NoXOff
  319.        mov  byte ptr es:[si+CSoftFlow],False
  320.        jmp  @Ok
  321. @NoXOff:
  322.        mov  byte ptr es:[si+CSoftFlow],False
  323. @NoSoftFlow:
  324.        mov  di,es:[si+CBuffer]
  325.        mov  bx,es:[si+CBuffer+2]
  326.        mov  cx,es:[si+CBufHead]
  327.        add  di,cx
  328.        adc  bx,0
  329.        push es
  330.        mov  es,bx
  331.        stosb
  332.        pop  es
  333.        cmp  cx,BufSize
  334.        jb   @NotEnd
  335.        xor  cx,cx
  336.        jmp  @StoreHead
  337. @NotEnd:
  338.        inc  cx
  339. @StoreHead:
  340.        mov  word ptr es:[si+CBufHead],cx
  341.        inc  word ptr es:[si+CCharsInBuf]
  342.        jmp  @Ok
  343. @BufFull:
  344.        mov  byte ptr es:[si+CBufOverflow],True
  345.        jmp  @NoData
  346. @Ok:   test bl,COMUseFIFO
  347.        jz   @NoFIFO2
  348.        push dx
  349.        add  dx,LSR
  350.        in   al,dx
  351.        pop  dx
  352.        test al,1
  353.        jnz  @NextChar
  354. @NoFIFO2:
  355. @NoData:
  356.        mov  al,$20
  357.        out  PIC,al
  358.        pop  es
  359.        pop  ds
  360.        pop  di
  361.        pop  si
  362.        pop  dx
  363.        pop  cx
  364.        pop  bx
  365.        pop  ax
  366.        sti
  367.        iret
  368.      end;
  369.  
  370. procedure TCOM.EnableInts; assembler; asm sti end;
  371. procedure TCOM.DisableInts; assembler; asm cli end;
  372.  
  373. { Ueberpruefe ob ein stabiles Traegersignal anliegt
  374.   *************************************************
  375.   Uebergabe: Nichts
  376.   Ausgbabe: True falls, wenn stabiles Traegersignal anliegt, sonst False }
  377.  
  378. function TCOM.CarrierDetect;
  379.      var
  380.        w: word;
  381.        b: boolean;
  382.      begin
  383.        if COMAttr and COMUseFossil>0 then begin
  384.          Regs.AH:=3;
  385.          Regs.DX:=IOPort-1;
  386.          Intr($14,Regs);
  387.          CarrierDetect:=Regs.AL and $80>0;
  388.        end else begin
  389.          w:=0;
  390.          b:=true;
  391.          while (w<500) and b do begin
  392.            Inc(w);
  393.            b:=(Port[IOBase+MSR] and 128)=0; { true=no carrier ! }
  394.          end;
  395.          CarrierDetect:=not b;
  396.        end;
  397.      end;
  398.  
  399. { Char an den initialisierten COM-Port schicken
  400.   *********************************************
  401.   Uebergabe:
  402.      C = zu sendender Buchstabe
  403.   Ausgabe: Nichts }
  404.  
  405. procedure TCOM.SendChar(C: Char);
  406.      begin
  407.        if COMAttr and COMUseFossil>0 then begin
  408.          Regs.AH:=1;
  409.          Regs.AL:=Ord(C);
  410.          Regs.DX:=IOPort-1;
  411.          Intr($14,Regs);
  412.        end else begin
  413.          while (Port[IOBase+LSR] and $20)=0 do ; {wait for Tx Hold Req Empty}
  414.          if COMAttr and COMHardFlow>0 then
  415.            while (Port[IOBase+MSR] and $10)=0 do ; { wait for CTS }
  416.          if COMAttr and COMSoftFlow>0 then
  417.            while SoftFLow and CarrierDetect do ;
  418.          Port[IOBase+MCR]:=$0B; { turn on OUT2, DTR, RTS }
  419.          DisableInts;
  420.          Port[IOBase+THR]:=Ord(C);
  421.          EnableInts;
  422.        end;
  423.      end;
  424.  
  425. { Ein Byte an den initialisierten COM-Port schicken
  426.   *************************************************
  427.   Uebergabe:
  428.      B = zu sendendes Byte
  429.   Ausgbabe: Nichts }
  430.  
  431. procedure TCOM.SendByte(B: Byte);
  432.      begin
  433.        SendChar(Chr(B));
  434.      end;
  435.  
  436. { Einen String an den initialisierten COM-Port schicken
  437.   *****************************************************
  438.   Uebergabe:
  439.      S = zu sendender String
  440.   Ausgbabe: Nichts }
  441.  
  442. procedure TCOM.SendStr(S: String);
  443.      var
  444.        I: Byte;
  445.      begin
  446.        for I:=1 to Length(S) do SendChar(S[I]);
  447.      end;
  448.  
  449. { Ueberpruefen ob Bytes angekommen sind
  450.   *************************************
  451.   Uebergabe: Nichts
  452.   Ausgabe: True falls Daten warten, False wenn nichts eingetroffen ist }
  453.  
  454. function TCOM.ByteAvail;
  455.      begin
  456.        if COMAttr and COMUseFossil>0 then begin
  457.          Regs.AH:=3;
  458.          Regs.DX:=IOPort-1;
  459.          Intr($14,Regs);
  460.          ByteAvail:=Regs.AH and 1>0;
  461.        end else
  462.          ByteAvail:=CharsInBuf>0;
  463.      end;
  464.  
  465. { Char aus dem Puffer lesen
  466.   *************************
  467.   Uebergabe: Nichts
  468.   Ausgabe: Empfangener Buchstabe }
  469.  
  470. function TCOM.ReadChar;
  471.      begin
  472.        if COMAttr and COMUseFossil>0 then begin
  473.          Regs.AH:=2;
  474.          Regs.DX:=IOPort-1;
  475.          Intr($14,Regs);
  476.          ReadChar:=Chr(Regs.AL);
  477.        end else begin
  478.          repeat until ByteAvail;
  479.          ReadChar:=Buffer^[BufTail];
  480.          Inc(BufTail);
  481.          if BufTail>BufSize then BufTail:=0;
  482.          Dec(CharsInBuf);
  483.        end;
  484.      end;
  485.  
  486. { Byte aus dem Puffer lesen
  487.   *************************
  488.   Uebergabe: Nichts
  489.   Ausgbabe: Empfangenes Byte }
  490.  
  491. function TCOM.ReadByte;
  492.      begin
  493.        ReadByte:=Ord(ReadChar);
  494.      end;
  495.  
  496. { String vom initialisierten COM-Port lesen
  497.   *****************************************
  498.   Uebergabe: Nichts
  499.   Ausgbabe: Empfangener String }
  500.  
  501. function TCOM.ReadString;
  502.      var
  503.        C: Char;
  504.        S: String;
  505.      begin
  506.        S:='';
  507.        repeat
  508.          C:=ReadChar;
  509.          S:=S+C;
  510.        until C=CR;
  511.        Dec(S[0]);
  512.        ReadString:=S;
  513.      end;
  514.  
  515. { Char aus dem Puffer (Zeichen bleibt im Puffer!)
  516.   ***********************************************
  517.   Uebergabe: Nichts
  518.   Ausgabe: Empfangener Buchstabe }
  519.  
  520. function TCOM.PeekChar;
  521.      begin
  522.        repeat until ByteAvail;
  523.        PeekChar:=Buffer^[BufTail];
  524.      end;
  525.  
  526. { Lesepuffer loeschen
  527.   *******************
  528.   Uebergabe: Nichts
  529.   Ausgabe: Nichts }
  530.  
  531. procedure TCOM.FlushInput;
  532.      begin
  533.        if COMAttr and COMUseFossil>0 then begin
  534.          Regs.AH:=$0A;
  535.          Regs.DX:=IOPort-1;
  536.          Intr($14,Regs);
  537.        end else begin
  538.          DisableInts;
  539.          BufTail:=BufHead;
  540.          CharsInBuf:=0;
  541.          EnableInts;
  542.        end;
  543.      end;
  544.  
  545. { DTR-Bereitschaft setzen/loeschen
  546.   ********************************
  547.   Uebergabe: True  - Setze DTR
  548.              False - Loesche DTR
  549.   Ausgabe: Nichts }
  550.  
  551. procedure TCOM.SetDTR;
  552.      begin
  553.        if COMAttr and COMUseFossil>0 then begin
  554.          Regs.AH:=6;
  555.          Regs.DX:=IOPort-1;
  556.          Regs.AL:=Ord(DTROn);
  557.          Intr($14,Regs);
  558.        end else
  559.          Port[IOBase+MCR]:=(Port[IOBase+MCR] and $FE) or Ord(DTROn);
  560.      end;
  561.  
  562. { Auflegen
  563.   ********
  564.   Uebergabe: Nichts
  565.   Ausgabe: True - Auflegen war erfolgreich, sonst False }
  566.  
  567. function TCOM.HangUp;
  568.      var
  569.        W: Word;
  570.      begin
  571.        if CarrierDetect then begin
  572.          W:=0;
  573.          SetDTR(False);
  574.          repeat
  575.            Delay(1);
  576.            Inc(W);
  577.          until (W=1000) or not CarrierDetect;
  578.          SetDTR(True);
  579.          if CarrierDetect then SendStr('+++ATH0'#13);
  580.        end;
  581.        HangUp:=NOT CarrierDetect;
  582.      end;
  583.  
  584. { Break-Signal ans Modem schicken
  585.   *******************************
  586.   Uebergabe: Nichts
  587.   Ausgabe: Nichts }
  588.  
  589. procedure TCOM.SendBreak;
  590.      var
  591.        CurTicks: LongInt;
  592.      begin
  593.        if COMAttr and COMUseFossil>0 then begin
  594.          Regs.AX:=$1A01;
  595.          Regs.DX:=IOPort-1;
  596.          Intr($14,Regs);
  597.        end else
  598.          Port[IOBase+LCR]:=Port[IOBase+LCR] or BRKSGN;
  599.        CurTicks:=MemL[$40:$6C];
  600.        repeat until CurTicks<>MemL[$40:$6C];
  601.        if COMAttr and COMUseFossil>0 then begin
  602.          Regs.AX:=$1A00;
  603.          Regs.DX:=IOPort-1;
  604.          Intr($14,Regs);
  605.        end else
  606.          Port[IOBase+LCR]:=Port[IOBase+LCR] or BRKSGN;
  607.      end;
  608.  
  609. procedure TCOM.GetCOMAttr;
  610.      var
  611.        IIR1,IIR2: Byte;
  612.      begin
  613.        IIR1:=Port[IOBase+IIR];
  614.        Port[IOBase+FCR]:=1;
  615.        IIR2:=Port[IOBase+IIR];
  616.        if IIR1 and $80=0 then Port[IOBase+IIR]:=0;
  617.        if IIR2 and $C0>0 then ACOMAttr:=ACOMAttr or COMUseFIFO;
  618.        Regs.AH:=4;
  619.        Regs.DX:=IOPort-1;
  620.        Intr($14,Regs);
  621.        if Regs.AX<>$1954 then ACOMAttr:=ACOMAttr and not COMUseFossil else
  622.          ACOMAttr:=ACOMAttr or COMUseFossil;
  623.      end;
  624.  
  625. begin
  626. end.
  627.